home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / OOP.SWG / 0038_Printing A tcollection.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  4KB  |  124 lines
  1.  
  2. unit BPrint;
  3. interface
  4. uses Objects, Prt;   { Prt is included after! }
  5. procedure PrintCollection(const Port : word; P : PStringCollection); 
  6. implementation 
  7. uses MsgBox, Views; 
  8. function WriteStr(Port : word; Str : String): boolean; 
  9. var x : boolean; 
  10.     q : word;
  11.     i : byte; 
  12. begin 
  13.     repeat 
  14.         x := Ready(Port); 
  15.         if not x then q := MessageBox(^C'Printer not Ready.  Try Again?', nil, 
  16.                            mfYesButton + mfNoButton + mfError); 
  17.     until x or (q = cmNo); 
  18.     i := 1; 
  19.     while (Ready(Port)) and (q <> cmNo) and (i <> Length(Str)+1) do begin 
  20.         x := Ready(Port); 
  21.         if not x then q := MessageBox(^C'Printer Error!  Try Again?', nil, 
  22.                            mfYesButton + mfNoButton + mfError);
  23.         if q <> cmNo then 
  24.             if WriteChar(Port, Str[i]) then Inc(i);
  25.     end; 
  26.     WriteStr := False; 
  27.     if Ready(Port) and (q <> cmNo) then begin 
  28.         WriteChar(Port, #13); 
  29.         WriteChar(Port, #10); 
  30.         WriteStr := True; 
  31.     end; 
  32. end; 
  33.  
  34. procedure PrintCollection(const Port : word; P : PStringCollection);
  35. var x : integer; 
  36.     q : word; 
  37. begin 
  38.     q := MessageBox(^C'To print, ready your printer and Press OK', nil, 
  39.          mfInformation + mfOkCancel); 
  40.     if q = cmOk then begin 
  41.         x := -1; 
  42.         repeat 
  43.             inc(x); 
  44.         until not WriteStr(Port, PString(P^.At(x))^) or (X = P^.Count - 1);
  45.     end;
  46.  
  47. end;
  48. end.
  49.  
  50. { ----          CUT HERE  -------- }
  51.  
  52. unit Prt;
  53. interface 
  54. uses objects; 
  55. const 
  56.     Lpt1        =   0;                  Lpt2        =   1; 
  57.     Lpt3        =   2;                  lf          = #10; 
  58.     cr          = #13;                  pTimeOut    = $01; 
  59.     pIOError    = $08;                  pNoPaper    = $20; 
  60.     pNotBusy    = $80;
  61.     pTestAll    = pTimeOut + pIOError + pNoPaper; 
  62. function WriteChar(const APort : word; s : char): boolean; 
  63. function Ready(const APort : word): boolean; 
  64. function Status(const APort : word): byte; 
  65. procedure InitPrinter(const APort : word); 
  66. implementation 
  67. procedure InitPrinter(const APort : word); assembler; 
  68. asm 
  69.     mov     ah, 1 
  70.     mov     bx, APort
  71.     int     17h 
  72. end;
  73. function Status(const APort : word): byte; assembler; 
  74. asm 
  75.     mov     ah, 2                   { Service 2 - Printer Status } 
  76.     mov     dx, APort             { Printer Port               } 
  77.     int     17h                     { ROM Printer Services       } 
  78.     mov     al, ah                  { Set function value         } 
  79. end; 
  80. function Ready(const APort : word): boolean; 
  81. begin 
  82.     Ready := Status(APort) and pTestAll = $00; 
  83. end; 
  84. function WriteChar(const APort : word; s : char): boolean;
  85. begin 
  86.     if Ready(APort) then 
  87.      asm 
  88.         mov     ah, 0               { Printer Service - Write Char } 
  89.         mov     al, s               { Char to write                } 
  90.         mov     dx, APort           { Printer Port                 }
  91.         int     17h                 { ROM Printer Services         } 
  92.         mov     al, 0               { Set procedure to false       } 
  93.         and     ah, 1               { Check for Error              } 
  94.         jnz     @End                { Jump to end if error         } 
  95.         mov     al, 1               { Set procedure to true        } 
  96.        @End:
  97.     end; 
  98. end;
  99.  
  100. end.
  101.  
  102. { ----------------   CUT HERE --------------------- }
  103. {
  104.     Here's a sample test program so you don't have to write one yourself
  105.     :).
  106. }
  107.  
  108. uses BPrint, Prt;
  109.  
  110. function Int2Str(const i : longint): string; 
  111. var s : string; 
  112. begin 
  113.    Str(i, s); 
  114.    Int2Str := s; 
  115. end; 
  116.  
  117. var x : integer; 
  118.     q : PStringCollection; 
  119. begin 
  120.     q := New(PStringCollection, Init(10, 10)); 
  121.     for x := 0 to 64 do q^.Insert(NewStr(Int2Str(Random(4000)))); 
  122.     PrintCollection(Lpt1 {Change for your printer}, q); 
  123. end. 
  124.